IRIS Performer 2.2 Friends Demo/SGI IRIS Performer 2.2 Friends Demo.iso/friends/openworlds/tix/FileEnt.tcl

Text File | 1997-11-22 | 5KB | 197 lines

# TixFileEntry Widget
#
#    An entry box for entering filenames.
#
#

tixWidgetClass tixFileEntry {
    -classname TixFileEntry
    -superclass tixLabelWidget
    -method {
    invoke filedialog
    }
    -flag {
    -command -dialogtype -disablecallback -disabledforeground -filebitmap
    -state -validatecmd -value -variable
    }
    -forcecall {
    -variable
    }
    -static {
    -filebitmap
    }
    -configspec {
    {-command command Command {}}
    {-dialogtype dialogType DialogType {}}
    {-disablecallback disableCallback DisableCallback false}
    {-disabledforeground disabledForeground DisabledForeground #303030}
    {-filebitmap fileBitmap FileBitmap [tix getbitmap openfile]}
    {-state state State normal}
    {-validatecmd validateCmd ValidateCmd {}}
    {-value value Value {}}
    {-variable variable Variable {}}
    }
    -default {
    {*frame.borderWidth        2}
    {*frame.relief            sunken}
    {*Label.font                   -Adobe-Helvetica-Bold-R-Normal--*-120-*}
    {*Button.highlightThickness    0}
    {*Entry.highlightThickness    0}
    {*Entry.borderWidth         0}
    {*Entry.background         #c3c3c3}
    }
}

proc tixFileEntry::InitWidgetRec {w} {
    upvar #0 $w data

    tixChainMethod $w InitWidgetRec
    set data(varInited)      0
}

proc tixFileEntry::ConstructFramedWidget {w frame} {
    upvar #0 $w data

    tixChainMethod $w ConstructFramedWidget $frame

    set data(w:entry)  [entry  $frame.entry]
    set data(w:button) [button $frame.button -bitmap $data(-filebitmap) \
    -takefocus 0]
    set data(entryfg) [$data(w:entry) cget -fg]

    pack $data(w:button) -side right -fill both
    pack $data(w:entry)  -side left  -expand yes -fill both
}

proc tixFileEntry::SetBindings {w} {
    upvar #0 $w data

    tixChainMethod $w SetBindings

    $data(w:button) config -command "tixFileEntry::OpenFile $w"
    tixSetMegaWidget $data(w:entry) $w

    # If user press <return>, verify the value and call the -command
    #
    bind $data(w:entry) <Return> "tixFileEntry::invoke $w"
    bind $data(w:entry) <FocusOut>  {
        if {"%d" == "NotifyNonlinear" || "%d" == "NotifyNonlinearVirtual"} {
        tixFileEntry::invoke [tixGetMegaWidget %W]
        }
    }
    bind $w <FocusIn> "focus $data(w:entry)"
}

#----------------------------------------------------------------------
#                           CONFIG OPTIONS
#----------------------------------------------------------------------
proc tixFileEntry::config-state {w value} {
    upvar #0 $w data

    if {$value == "normal"} {
    $data(w:button) config -state $value
    $data(w:entry)  config -state $value -fg $data(entryfg)
    $data(w:label)  config -fg $data(entryfg)
    } else {
    $data(w:button) config -state $value
    $data(w:entry)  config -state $value -fg $data(-disabledforeground)
    $data(w:label)  config -fg $data(-disabledforeground)
    }
}

proc tixFileEntry::config-value {w value} {
    tixFileEntry::SetValue $w $value
}

proc tixFileEntry::config-variable {w arg} {
    upvar #0 $w data

    if [tixVariable:ConfigVariable $w $arg] {
       # The value of data(-value) is changed if tixVariable:ConfigVariable
       # returns true
       tixFileEntry::SetValue $w $data(-value)
    }
    catch {
    unset data(varInited)
    }
    set data(-variable) $arg
}

#----------------------------------------------------------------------
#                         User Commands
#----------------------------------------------------------------------
proc tixFileEntry::invoke {w} {
    upvar #0 $w data

    if {[catch {$data(w:entry) index sel.first}] == 0} {
    # THIS ENTRY OWNS SELECTION --> TURN IT OFF
    #
    $data(w:entry) select from end
    $data(w:entry) select to   end
    }

    tixFileEntry::SetValue $w [$data(w:entry) get]
}

proc tixFileEntry::filedialog {w} {
    upvar #0 $w data

    return [tix filedialog $data(-dialogtype)]
}

#----------------------------------------------------------------------
#                       Internal Commands
#----------------------------------------------------------------------
proc tixFileEntry::OpenFile {w} {
     upvar #0 $w data

     set filedlg [tix filedialog $data(-dialogtype)]

     $filedlg config -parent [winfo toplevel $w] \
     -command "tixFileEntry::FileDlgCallback $w"

     focus $data(w:entry)

     $filedlg popup
}

proc tixFileEntry::FileDlgCallback {w filename} {
    tixFileEntry::SetValue $w $filename
}

proc tixFileEntry::SetValue {w value} {
    upvar #0 $w data

    if {$data(-validatecmd) != {}} {
    set value [eval $data(-validatecmd) [list $value]]
    }

    if {$data(-state) == "normal"} {
    $data(w:entry) delete 0 end
    $data(w:entry) insert 0 $value
    $data(w:entry) xview end
    }

    set data(-value) $value

    tixVariable:UpdateVariable $w

    if {$data(-command) != {} &&
    ![tixGetBoolean -nocomplain $data(-disablecallback)]} {
    if {![info exists data(varInited)]} {
        eval $data(-command) [list $value]
    }
    }
}

proc tixFileEntry::Destructor {w} {
    upvar #0 $w data

    tixUnsetMegaWidget $data(w:entry)
    tixVariable:DeleteVariable $w

    # Chain this to the superclass
    #
    tixChainMethod $w Destructor
}